home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
tvtoys04.zip
/
HELPTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-07
|
4KB
|
135 lines
(***************************************************************************
HelpTest program
A demonstration program showing off the patched HelpFile
PJB September 2, 1993, Internet mail to d91-pbr@nada.kth.se
Copyright PJB 1993, All Rights Reserved. Portions Copyright Borland.
Free source, use at your own risk.
If modified, please state so if you pass this around.
Most of the functionality comes from toyApp and several commands are
defined in toyPrefs. HelpCtx was generated by TVHC.
ToyApp registers HelpFile for us.
This program is NOT meant to be a style guide, it's just a demonstration
***************************************************************************)
program HelpTest;
{$X+}
uses
Dos,
App, Drivers, Menus, Objects, Views,
toyPrefs, HelpCtx,
HelpFile, toyApp;
(***************************************************************************
***************************************************************************)
(* Demonstration constants *)
const
ExeName = 'HELPTEST.EXE';
HelpName = 'HELPTEST.HLP';
(* cmUsingHelp is the same as cmHelpOnHelp in the BP IDE *)
cmUsingHelp = 1000;
(***************************************************************************
***************************************************************************)
type
TMain =
object (TToyApp)
constructor Init;
procedure InitMenubar; virtual;
procedure InitStatusLine; virtual;
procedure HandleEvent(var Event:TEvent); virtual;
end;
(*******************************************************************
Initialize
*******************************************************************)
constructor TMain.Init;
begin
inherited Init;
ExeFileName:=ExeName; (* This is needed for DOS 1.x and 2.x *)
HelpFileName:=HelpName; (* We're not using ExeHelp, so... *)
ShowHelp(hcHelpIntro); (* Intro text *)
end;
(*******************************************************************
Translate Help Menu command(s)
Most are handled by toyApp
*******************************************************************)
procedure TMain.HandleEvent;
begin
inherited HandleEvent(Event);
if Event.What=evCommand then
begin
case Event.Command of
(* This command should not be handled by TMain.GetEvent *)
cmUsingHelp: ShowHelp(hcUsingHelp); (* TP IDE uses hcHelpOnHelp *)
else
Exit;
end;
ClearEvent(Event);
end;
end;
(*******************************************************************
Demonstration Menu bar
*******************************************************************)
procedure TMain.InitMenubar;
var
R : TRect;
begin
GetExtent(R);
R.B.Y:=R.A.Y+1;
MenuBar:=New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~H~elp', hcHelp, NewMenu(
NewItem('~C~ontents', '', kbNoKey, cmHelpContents, hctoyHHelp,
NewItem('~P~revious topic', '', kbNoKey, cmPreviousTopic, hctoyHPreviousTopic,
NewItem('~U~sing help', '', kbNoKey, cmUsingHelp, hctoyHUsingHelp,
nil)))),
nil))));
end;
(*******************************************************************
Demonstration Status line. Uses some DOS 6 Help keys
*******************************************************************)
procedure TMain.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
New(StatusLine, Init(R,
StdStatusHelp( (* It's in TOYPREFS.PAS *)
NewStatusDef(0, $FFFF,
StdStatusKeys(
NewStatusKey('~F1~ Help', kbF1, cmHelp,
NewStatusKey('~Alt+X~ Exit', kbAltX, cmQuit,
Nil))),
Nil))));
end;
(*******************************************************************
*******************************************************************)
var
Main : TMain;
begin
Main.Init;
Main.Run;
Main.Done;
end.